wVERSION = 3.00_setPcsetcommand uoldvalue uoldvalue1 uoldvalue2 lerror lnorestore checkvalue Pixels_runcodePixels8Runs a block of VFP code via macros without compilation.ClassClass1_custom_set _shellexecutePixelsClass1_custom _shellexecute1_custom_runcode3*runcode RunCode(cCode[, lFile] [,llgnoreErrors]) * % U%C7 BTC-TCC tcWorkDirbCC6=TCC tcOperationbCC COpen6.| ShellExecute SHELL32.DLLBCU TCFILENAME TCWORKDIR TCOPERATION LCFILENAME LCWORKDIR LCOPERATION SHELLEXECUTESHELL32DLL shellexecute,1A20);PROCEDURE shellexecute * WinApi :: ShellExecute ** Function: Opens a file in the application that it's ** associated with. ** Pass: lcFileName - Name of the file to open ** ** Return: 2 - Bad Association (e.g., invalid URL) ** 31 - No application association ** 29 - Failure to load application ** 30 - Application is busy ** ** Values over 32 indicate success ** and return an instance handle for ** the application started (the browser) LPARAMETERS tcFileName,tcWorkDir,tcOperation LOCAL lcFileName,lcWorkDir,lcOperation IF EMPTY(tcFileName) RETURN -1 ENDIF lcFileName=ALLTRIM(tcFileName) lcWorkDir=IIF(TYPE("tcWorkDir")="C",ALLTRIM(tcWorkDir),"") lcOperation=IIF(TYPE("tcOperation")="C" AND NOT EMPTY(tcOperation),ALLTRIM(tcOperation),"Open") *-* HINSTANCE ShellExecute(hwnd, lpszOp, lpszFile, lpszParams, lpszDir, wShowCmd) *-* *-* HWND hwnd - handle of parent window *-* LPCTSTR lpszOp - address of string for operation to perform *-* LPCTSTR lpszFile - address of string for filename *-* LPTSTR lpszParams - address of string for executable-file parameters *-* LPCTSTR lpszDir - address of string for default directory *-* INT wShowCmd - whether file is shown when opened DECLARE INTEGER ShellExecute ; IN SHELL32.DLL ; INTEGER nWinHandle,; STRING cOperation,; STRING cFileName,; STRING cParameters,; STRING cDirectory,; INTEGER nShowWindow RETURN ShellExecute(0,lcOperation,lcFilename,"",lcWorkDir,1) ENDPROC Name = "_shellexecute" custom _base.vcxUsed to save, set, and restore SET commands. Optional parameters: uArgument1 [, uArgument2] [, lNoRestore]. This classes only handles SET commands that have a unique first four characters in their name and a few SET commands not fully supported.csetcommand The SET command name. uoldvalue The original setting of the SET command as SET(). uoldvalue1 The original setting of the SET command as SET(,1). uoldvalue2 The original setting of the SET command as SET(,2). lerror Indicates an error occured during the execution of the SET command. lnorestore Specifies if the original SET values are restored when the object is released. *getsetcommand Returns the SET command name. *restore Restores the original SET settings. *set Sets environment setting. uArgument1 [, uArgument2] [, lNoRestore] *get No parameter returns the current SET() value. 1 returns the current SET(,1) value. 2 returns the current SET(,2) value. 0 returns the original SET() value. -1 returns the original SET(,1) value. -2 returns the original SET(,2) value. *disablerestore Disables the automatic restore of settings when in object release mode. *checkvalue Returns the proper SET() value baesd on the SET command name.  W > > Ԣ % u o U BUTHIS CSETCOMMAND TaTCTCTCX%Cv C &Cv C   T-'%Cv C  T- BULLRESULT LCOLDVALUE LCOLDVALUE1 LCOLDVALUE2THISGET CSETCOMMANDSET$T-%CGB-TC tuArgument1bTC tuArgument2bTCC =$%C L  p%C(%%PRIN CfPRN T TO$T TO []LT TO CC Z SET &lcSetCommand &lcClauses $%C L  %C T%CLAS COLL COVE DATA DEFA DEBU DEVI DISP EVEN FILT FORM INDE KEY KEYC LIBR MACK MARK MESS NOCP ORDE PATH PDSE POIN PROC RELA SEPA SKIP TOPI TYPE UDFP XCMD T TO T TO CC Z SET &lcSetCommand &lcClauses $% C  B-U TUARGUMENT1 TUARGUMENT2TLDISABLERESTORE LCSETCOMMANDLCTYPE1LCTYPE2 LCCLAUSESTHISLERROR CSETCOMMANDDISABLERESTORE<  T- H*, C tnArgumentbNaTCCv T Ta TCv TCv T T2,B BU TNARGUMENTLCVALUELLADJUSTTHIS CHECKVALUE CSETCOMMAND UOLDVALUE UOLDVALUE1 UOLDVALUE2TaUTHIS LNORESTOREl%CtcValuebC+ B%C=DEFA\BC] BUTCVALUETHIS CSETCOMMAND TaUNERRORCMETHODNLINETHISLERROR, TCt=%C C C tcSetCommandbC hBT-TCCfTCCv %B-T CvT Cv)%C %B-U TCSETCOMMAND TUARGUMENT1 TUARGUMENT2TLDISABLERESTORE LNPARAMETERSTHISLERROR CSETCOMMAND UOLDVALUE CHECKVALUE UOLDVALUE1 UOLDVALUE2SET%%  BCUTHIS LNORESTORERESTORE getsetcommand,restoreRsetgetRdisablerestore checkvalueErrorInitDestroy 131AQQArA31qAqA!QAAAA!aQAAAAqA3qQQ!!qA33qAA331qAAAqAqA3A22P%?& 5@  OK@ U hMv  lV0 g xY ~k)> PROCEDURE getsetcommand RETURN this.cSetCommand ENDPROC PROCEDURE restore LOCAL llResult,lcOldValue,lcOldValue1,lcOldValue2 llResult=.T. lcOldValue=this.Get(0) lcOldValue1=this.Get(-1) lcOldValue2=this.Get(-2) IF (NOT lcOldValue1==SET(this.cSetCommand,1) AND ; NOT this.Set(lcOldValue,lcOldValue1)) OR ; (NOT lcOldValue2==SET(this.cSetCommand,2) AND ; NOT this.Set(lcOldValue,lcOldValue2)) llResult=.F. ENDIF IF NOT lcOldValue==SET(this.cSetCommand) AND ; NOT this.Set(lcOldValue) llResult=.F. ENDIF RETURN llResult ENDPROC PROCEDURE set LPARAMETERS tuArgument1,tuArgument2,tlDisableRestore LOCAL lcSetCommand,lcType1,lcType2,lcClauses this.lError=.F. IF PARAMETERS()=0 RETURN .F. ENDIF lcType1=TYPE("tuArgument1") lcType2=TYPE("tuArgument2") lcSetCommand=ALLTRIM(LEFT(this.cSetCommand,4)) IF NOT ISNULL(tuArgument2) AND NOT lcType2=="L" OR tuArgument2 IF lcType2=="C" IF lcSetCommand=="PRIN" AND UPPER(tuArgument2)=="PRN" lcClauses=" TO" ELSE lcClauses=" TO ["+tuArgument2+"]" ENDIF ELSE lcClauses=" TO "+ALLTRIM(STR(tuArgument2,9)) ENDIF SET &lcSetCommand &lcClauses ENDIF IF NOT ISNULL(tuArgument1) AND NOT lcType1=="L" OR tuArgument1 IF lcType1=="C" lcClauses=tuArgument1 IF lcSetCommand=="CLAS" OR lcSetCommand=="COLL" OR ; lcSetCommand=="COVE" OR lcSetCommand=="DATA" OR ; lcSetCommand=="DEFA" OR lcSetCommand=="DEBU" OR ; lcSetCommand=="DEVI" OR lcSetCommand=="DISP" OR ; lcSetCommand=="EVEN" OR lcSetCommand=="FILT" OR ; lcSetCommand=="FORM" OR lcSetCommand=="INDE" OR ; lcSetCommand=="KEY" OR lcSetCommand=="KEYC" OR ; lcSetCommand=="LIBR" OR lcSetCommand=="MACK" OR ; lcSetCommand=="MARK" OR lcSetCommand=="MESS" OR ; lcSetCommand=="NOCP" OR lcSetCommand=="ORDE" OR ; lcSetCommand=="PATH" OR lcSetCommand=="PDSE" OR ; lcSetCommand=="POIN" OR lcSetCommand=="PROC" OR ; lcSetCommand=="RELA" OR lcSetCommand=="SEPA" OR ; lcSetCommand=="SKIP" OR lcSetCommand=="TOPI" OR ; lcSetCommand=="TYPE" OR lcSetCommand=="UDFP" OR ; lcSetCommand=="XCMD" lcClauses=" TO "+lcClauses ENDIF ELSE lcClauses=" TO "+ALLTRIM(STR(tuArgument1,9)) ENDIF SET &lcSetCommand &lcClauses ENDIF IF this.lError OR (tlDisableRestore AND NOT this.DisableRestore()) RETURN .F. ENDIF ENDPROC PROCEDURE get LPARAMETERS tnArgument LOCAL lcValue,llAdjust llAdjust=.F. DO CASE CASE TYPE("tnArgument")#"N" lcValue=this.CheckValue(SET(this.cSetCommand)) CASE tnArgument=0 lcValue=this.uOldValue llAdjust=.T. CASE tnArgument=1 lcValue=SET(this.cSetCommand,1) CASE tnArgument=2 lcValue=SET(this.cSetCommand,2) CASE tnArgument=-1 lcValue=this.uOldValue1 CASE tnArgument=-2 lcValue=this.uOldValue2 OTHERWISE RETURN .NULL. ENDCASE RETURN lcValue ENDPROC PROCEDURE disablerestore this.lNoRestore=.T. ENDPROC PROCEDURE checkvalue LPARAMETERS tcValue IF TYPE("tcValue")#"C" RETURN tcValue ENDIF IF LEFT(this.cSetCommand,4)=="DEFA" RETURN tcValue+SYS(2003) ENDIF RETURN tcValue ENDPROC PROCEDURE Error LPARAMETERS nError, cMethod, nLine this.lError=.T. ENDPROC PROCEDURE Init LPARAMETERS tcSetCommand,tuArgument1,tuArgument2,tlDisableRestore LOCAL lnParameters lnParameters=PCOUNT() IF lnParameters=0 OR EMPTY(tcSetCommand) OR ISNULL(tcSetCommand) OR ; TYPE("tcSetCommand")#"C" RETURN ENDIF this.lError=.F. this.cSetCommand=UPPER(ALLTRIM(tcSetCommand)) this.uOldValue=this.CheckValue(SET(this.cSetCommand)) IF this.lError RETURN .F. ENDIF this.uOldValue1=SET(this.cSetCommand,1) this.uOldValue2=SET(this.cSetCommand,2) IF lnParameters>=2 AND ; NOT this.Set(tuArgument1,tuArgument2,tlDisableRestore) RETURN .F. ENDIF ENDPROC PROCEDURE Destroy IF NOT this.lNoRestore RETURN this.Restore() ENDIF ENDPROC ]csetcommand = uoldvalue = .NULL. uoldvalue1 = .NULL. uoldvalue2 = .NULL. Name = "_set" custom$cversion = 1.02 Name = "_runcode" custom _base.vcx _base.vcx:Opens a file in the application that it's associated with.*shellexecute Runs ShellExecute API routine, which is simlar to double-clicking file in explorer. Parameters: (cFileName, cWorkDir, cOperation, cParams) O 6668%U      !"+#$%&#$%&%CCTC1!TC =.F.__6T  06.0Ch% TCERROR % 1=.F.{ Ta % TTCC̛#TCCC6%C=;5TC;C C #TCExecScript(__lcCode)%Cs{ON ERROR &__lcLastOnError  B TC __tcCode[1]bC %TC# -%CCC B %] TTCC̛%CYBtTC%C=;TC;C C TC#%B5' T' T+ )TTCC#T C&&% xTCC = +a,T C=%   C  TCC\.T CR%   C  $TCCC>=`.!r%CC=* C=# C=&& CC=fNOTE C=